home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch10 / FlakeAn2.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-08  |  6KB  |  205 lines
  1. VERSION 5.00
  2. Begin VB.Form frmFlakeAn2 
  3.    Caption         =   "FlakeAn2"
  4.    ClientHeight    =   4335
  5.    ClientLeft      =   2280
  6.    ClientTop       =   900
  7.    ClientWidth     =   5070
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   4335
  11.    ScaleWidth      =   5070
  12.    Begin VB.TextBox txtTheta 
  13.       Height          =   285
  14.       Left            =   600
  15.       MaxLength       =   3
  16.       TabIndex        =   1
  17.       Text            =   "60"
  18.       Top             =   360
  19.       Width           =   375
  20.    End
  21.    Begin VB.TextBox txtDepth 
  22.       Height          =   285
  23.       Left            =   600
  24.       MaxLength       =   3
  25.       TabIndex        =   0
  26.       Text            =   "3"
  27.       Top             =   0
  28.       Width           =   375
  29.    End
  30.    Begin VB.PictureBox picCanvas 
  31.       AutoRedraw      =   -1  'True
  32.       Height          =   4335
  33.       Left            =   1080
  34.       ScaleHeight     =   285
  35.       ScaleMode       =   3  'Pixel
  36.       ScaleWidth      =   261
  37.       TabIndex        =   4
  38.       Top             =   0
  39.       Width           =   3975
  40.    End
  41.    Begin VB.CommandButton cmdGo 
  42.       Caption         =   "Go"
  43.       Default         =   -1  'True
  44.       Height          =   375
  45.       Left            =   240
  46.       TabIndex        =   2
  47.       Top             =   840
  48.       Width           =   615
  49.    End
  50.    Begin VB.Label Label1 
  51.       Caption         =   "Theta"
  52.       Height          =   255
  53.       Index           =   1
  54.       Left            =   0
  55.       TabIndex        =   5
  56.       Top             =   360
  57.       Width           =   495
  58.    End
  59.    Begin VB.Label Label1 
  60.       Caption         =   "Depth"
  61.       Height          =   255
  62.       Index           =   0
  63.       Left            =   0
  64.       TabIndex        =   3
  65.       Top             =   0
  66.       Width           =   495
  67.    End
  68. Attribute VB_Name = "frmFlakeAn2"
  69. Attribute VB_GlobalNameSpace = False
  70. Attribute VB_Creatable = False
  71. Attribute VB_PredeclaredId = True
  72. Attribute VB_Exposed = False
  73. Option Explicit
  74. Private Const PI = 3.14159
  75. ' Coordinates of the points in the initiator.
  76. Private Const NUM_INITIATOR_POINTS = 3
  77. Private InitiatorX(0 To NUM_INITIATOR_POINTS) As Single
  78. Private InitiatorY(0 To NUM_INITIATOR_POINTS) As Single
  79. ' Angles and distances for the generator.
  80. Private Const NUM_GENERATOR_ANGLES = 4
  81. Private ScaleFactor As Single
  82. Private GeneratorDTheta(1 To NUM_GENERATOR_ANGLES) As Single
  83. ' Draw the complete snowflake.
  84. Private Sub DrawFlake(ByVal depth As Integer, ByVal length As Single)
  85. Dim i As Integer
  86. Dim x1 As Single
  87. Dim y1 As Single
  88. Dim x2 As Single
  89. Dim y2 As Single
  90. Dim dx As Single
  91. Dim dy As Single
  92. Dim theta As Single
  93.     picCanvas.Cls
  94.     ' Draw the snowflake.
  95.     For i = 1 To NUM_INITIATOR_POINTS
  96.         x1 = InitiatorX(i - 1)
  97.         y1 = InitiatorY(i - 1)
  98.         x2 = InitiatorX(i)
  99.         y2 = InitiatorY(i)
  100.         dx = x2 - x1
  101.         dy = y2 - y1
  102.         theta = ATan2(dy, dx)
  103.         DrawFlakeEdge depth, x1, y1, _
  104.             theta, length
  105.     Next i
  106. End Sub
  107. ' Draw the animation frames.
  108. Private Sub MakeMovie(ByVal depth As Integer, ByVal length As Single, ByVal max_angle As Single)
  109. Const MS_PER_FRAME = 50
  110. Const D_ANGLE = 5
  111. Dim next_time As Long
  112. Dim angle As Single
  113.     ' Draw the snowflakes.
  114.     next_time = GetTickCount()
  115.     For angle = 0 To max_angle Step D_ANGLE
  116.         InitializeGenerator angle / 180 * PI, length
  117.         WaitTill next_time
  118.         DrawFlake depth, length
  119.         DoEvents
  120.         next_time = next_time + MS_PER_FRAME
  121.     Next angle
  122. End Sub
  123. Private Sub CmdGo_Click()
  124. Dim depth As Integer
  125. Dim length As Single
  126. Dim max_angle As Single
  127. Dim unit As Single
  128. Dim vunit As Single
  129. Dim hunit As Single
  130.     picCanvas.Cls
  131.     MousePointer = vbHourglass
  132.     DoEvents
  133.     ' Get the parameters.
  134.     If Not IsNumeric(txtDepth.Text) Then txtDepth.Text = "5"
  135.     depth = CInt(txtDepth.Text)
  136.     ' Get the final angle.
  137.     If Not IsNumeric(txtTheta.Text) Then txtTheta.Text = "60"
  138.     max_angle = CInt(txtTheta.Text)
  139.     ' See how big we can make the curve.
  140.     vunit = 0.9 * picCanvas.ScaleHeight / (Sqr(3) * 4 / 3)
  141.     hunit = 0.9 * picCanvas.ScaleWidth / 2
  142.     If vunit < hunit Then
  143.         unit = vunit
  144.     Else
  145.         unit = hunit
  146.     End If
  147.     length = 2 * unit
  148.     ' Draw the animation frames.
  149.     MakeMovie depth, length, max_angle
  150.     MousePointer = vbDefault
  151.     Beep
  152. End Sub
  153. ' Initialize the generator for the indicated angle.
  154. Private Sub InitializeGenerator(ByVal theta As Single, ByVal length As Single)
  155. Dim xmid As Single
  156. Dim ymid As Single
  157.     ' Initialize the initiator's coordinates.
  158.     xmid = picCanvas.ScaleWidth / 2
  159.     ymid = picCanvas.ScaleHeight / 2
  160.     InitiatorX(1) = xmid + length / 2
  161.     InitiatorY(1) = ymid - length / 2 * Sqr(3) / 3
  162.     InitiatorX(2) = xmid - length / 2
  163.     InitiatorY(2) = InitiatorY(1)
  164.     InitiatorX(3) = xmid
  165.     InitiatorY(3) = ymid + length / 2 * Sqr(3) * 2 / 3
  166.     InitiatorX(0) = InitiatorX(3)
  167.     InitiatorY(0) = InitiatorY(3)
  168.     ScaleFactor = 1 / (2 * (1 + Cos(theta)))
  169.     GeneratorDTheta(1) = 0
  170.     GeneratorDTheta(2) = theta
  171.     GeneratorDTheta(3) = -2 * theta
  172.     GeneratorDTheta(4) = theta
  173. End Sub
  174. ' Recursively draw a snowflake edge starting at
  175. ' (x1, y1) in direction theta and distance dist.
  176. ' Leave the coordinates of the endpoint in
  177. ' (x1, y1).
  178. Private Sub DrawFlakeEdge(ByVal depth As Integer, ByRef x1 As Single, ByRef y1 As Single, ByVal theta As Single, ByVal dist As Single)
  179. Dim status As Integer
  180. Dim i As Integer
  181. Dim x2 As Single
  182. Dim y2 As Single
  183.     If depth <= 0 Then
  184.         x2 = x1 + dist * Cos(theta)
  185.         y2 = y1 + dist * Sin(theta)
  186.         picCanvas.Line (x1, y1)-(x2, y2)
  187.         x1 = x2
  188.         y1 = y2
  189.         Exit Sub
  190.     End If
  191.     ' Recursively draw the edge.
  192.     dist = dist * ScaleFactor
  193.     For i = 1 To NUM_GENERATOR_ANGLES
  194.         theta = theta + GeneratorDTheta(i)
  195.         DrawFlakeEdge depth - 1, x1, y1, theta, dist
  196.     Next i
  197. End Sub
  198. Private Sub Form_Resize()
  199. Dim wid As Single
  200.     ' Make the picCanvas as big as possible.
  201.     wid = ScaleWidth - picCanvas.Left
  202.     If wid < 120 Then wid = 120
  203.     picCanvas.Move picCanvas.Left, 0, wid, ScaleHeight
  204. End Sub
  205.